home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1997 / MacHack 1997.toast / Hacks / Hacks ’94 / [√] Distribution Restricted! / Christian Ruse / Fourier Paper + Apps / nih-image154_source.sea / V1.54 Source / PlugIns.p < prev    next >
Text File  |  1994-01-27  |  26KB  |  967 lines
  1. unit PlugIns;
  2. {This unit for utilizing Adobe Photoshop compatible acquisition, export and filter plug-ins}
  3. {is based on code written by Greg Brown, Steven Gonzalo and Richard Ohlendorf.}
  4. {Ohlendorf Research, Inc.}
  5. {818 LaSalle Street}
  6. {Ottawa, IL 61350}
  7. {815-434-5622}
  8. {Applelink--Abraham@AppleLink.com}
  9.  
  10. interface
  11.     uses
  12.         QuickDraw, Palettes, QDOffscreen, PrintTraps, Globals, utilities, Graphics, Lut, Filters, Stacks, File1, File2;
  13.  
  14.     procedure RunAcqPlugIn (item: integer);
  15.     procedure LoadAcqPlugIn (FileName: str255);
  16.     procedure RunExportPlugIn (item: integer);
  17.     procedure RunFilterPlugIn (item: integer);
  18.     procedure LoadFilterPlugIn (FileName: str255);
  19.  
  20.  
  21. implementation
  22.  
  23.     type
  24.         MonitorRec = record
  25.                 gamma: Fixed;
  26.                 redX: Fixed;
  27.                 redY: Fixed;
  28.                 greenX: Fixed;
  29.                 greenY: Fixed;
  30.                 blueX: Fixed;
  31.                 blueY: Fixed;
  32.                 whiteX: Fixed;
  33.                 whiteY: Fixed;
  34.                 ambient: Fixed;
  35.             end;
  36.  
  37.         PlaneMapType = array[0..15] of integer;
  38.  
  39.         AcquireRecord = record
  40.                 serialNumber: LongInt;
  41.                 abortProc: ProcPtr;
  42.                 progressProc: ProcPtr;
  43.                 maxData: LongInt;
  44.                 imageMode: integer;
  45.                 fImageSize: Point;
  46.                 depth: integer;
  47.                 planes: integer;
  48.                 imageHRes: Fixed;
  49.                 imageVRes: Fixed;
  50.                 rLUT: packed array[0..255] of char;
  51.                 gLUT: packed array[0..255] of char;
  52.                 bLUT: packed array[0..255] of char;
  53.                 data: Ptr;
  54.                 theRect: Rect;
  55.                 loPlane: integer;
  56.                 hiPlane: integer;
  57.                 colBytes: integer;
  58.                 rowBytes: LongInt;
  59.                 planeBytes: LongInt;
  60.                 FileName: Str255;
  61.                 vRefNum: integer;
  62.                 dirty: boolean;
  63.          {Version 4 fields}
  64.                 hostSig: OSType;
  65.                 hostProc: ProcPtr;
  66.                 hostModes: LongInt;
  67.                 planeMap: PlaneMapType;
  68.                 canTranspose: boolean;
  69.                 needTranspose: boolean;
  70.                 duotoneInfo: Handle;
  71.                 diskSpace: LongInt;
  72.                 spaceProc: ProcPtr;
  73.                 monitor: MonitorRec;
  74.                 reserved: packed array[0..255] of char;
  75.             end;
  76.  
  77.         FilterColor = packed array[0..3] of char;
  78.  
  79.         FilterRecord = record
  80.                 serialNumber: LongInt;
  81.                 abortProc: ProcPtr;
  82.                 progressProc: ProcPtr;
  83.                 parameters: Handle;
  84.                 fImageSize: Point;
  85.                 planes: integer;
  86.                 filterRect: Rect;
  87.                 background: RGBColor;
  88.                 foreground: RGBColor;
  89.                 maxSpace: LongInt;
  90.                 bufferSpace: LongInt;
  91.                 inRect: Rect;
  92.                 inLoPlane: integer;
  93.                 inHiPlane: integer;
  94.                 outRect: Rect;
  95.                 outLoPlane: integer;
  96.                 outHiPlane: integer;
  97.                 inData: Ptr;
  98.                 inRowBytes: LongInt;
  99.                 outData: Ptr;
  100.                 outRowBytes: LongInt;
  101.                 isFloating: boolean;
  102.                 haveMask: boolean;
  103.                 autoMask: boolean;
  104.                 maskRect: Rect;
  105.                 maskData: Ptr;
  106.                 maskRowBytes: LongInt;
  107.          {Version 4 fields}
  108.                 backColor: FilterColor;
  109.                 foreColor: FilterColor;
  110.                 hostSig: OSType;
  111.                 hostProc: ProcPtr;
  112.                 imageMode: integer;
  113.                 imageHRes: Fixed;
  114.                 imageVRes: Fixed;
  115.                 floatCoord: Point;
  116.                 wholeSize: Point;
  117.                 monitor: MonitorRec;
  118.                 reserved: packed array[0..255] of char;
  119.             end;
  120.  
  121.  
  122.         ExportRecord = record
  123.                 serialNumber: LongInt;
  124.                 abortProc: ProcPtr;
  125.                 progressProc: ProcPtr;
  126.                 maxData: LongInt;
  127.                 imageMode: integer;
  128.                 eImageSize: Point;
  129.                 depth: integer;
  130.                 planes: integer;
  131.                 imageHRes: Fixed;
  132.                 imageVRes: Fixed;
  133.                 rLUT: packed array[0..255] of char;
  134.                 gLUT: packed array[0..255] of char;
  135.                 bLUT: packed array[0..255] of char;
  136.                 theRect: Rect;
  137.                 loPlane: integer;
  138.                 hiPlane: integer;
  139.                 data: Ptr;
  140.                 rowBytes: LongInt;
  141.                 filename: Str255;
  142.                 vRefNum: integer;
  143.                 dirty: BOOLEAN;
  144.                 selectBBox: Rect;
  145.         {Version 4 fields }
  146.                 hostSig: OSType;
  147.                 hostProc: ProcPtr;
  148.                 duotoneInfo: Handle;
  149.                 thePlane: integer;
  150.                 monitor: MonitorRec;
  151.                 reserved: packed array[0..255] of char;
  152.             end;
  153.  
  154.  
  155.     var
  156.         acqData, exportData, filterData, nlines, rowpix: LongInt;
  157.         disppict, srcpict: ptr;
  158.         refnum: integer;
  159.         ShowProgress: boolean;
  160.         ProgressMsg: string[17];
  161.         FilterRec: FilterRecord;
  162.  
  163.  
  164.     procedure DummyProc;
  165.     begin
  166.     end;
  167.  
  168.     function TestAbort: boolean;
  169.     begin
  170.         if commandperiod then
  171.             testabort := true
  172.         else
  173.             testabort := false;
  174.     end;
  175.  
  176.  
  177.     procedure UpdateProgress (done, total: LongInt);
  178.         var
  179.             whatpercent: integer;
  180.     begin
  181.         if ShowProgress and (done > 0) and (total > 0) and (total >= done) then begin
  182.                 whatpercent := round((done / total) * 100);
  183.                 UpdateMeter(whatpercent, ProgressMsg);
  184.             end;
  185.     end;
  186.  
  187.  
  188.  
  189.     procedure CopyData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes: LongInt; lines: integer);
  190.         var
  191.             i: integer;
  192.             dst: ptr;
  193.             width: LongInt;
  194.     begin
  195.         with theRect do
  196.             width := right - left;
  197.         with info^ do
  198.             dst := ptr(ord4(PicBaseAddr) + LongInt(therect.top) * BytesPerRow + therect.left);
  199.         for i := 0 to lines - 1 do begin
  200.                 BlockMove(src, dst, width);
  201.                 src := ptr(ord4(src) + srcRowBytes);
  202.                 dst := ptr(ord4(dst) + dstRowBytes);
  203.             end;
  204.     end;
  205.  
  206.  
  207.     procedure CopyInterleavedRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, colBytes: LongInt; lines: integer; planeMap: PlaneMapType);
  208.         var
  209.             i, j, slice, plane, width: integer;
  210.             src2, src3, dst2, dst3: ptr;
  211.     begin
  212.         with theRect do
  213.             width := right - left;
  214.         with info^.StackInfo^ do
  215.             for slice := 1 to 3 do begin
  216.                     CurrentSlice := slice;
  217.                     SelectSlice(slice);
  218.                     plane := planeMap[slice - 1];
  219.                     src2 := src;
  220.                     dst2 := ptr(ord4(info^.PicBaseAddr) + LongInt(therect.top) * info^.BytesPerRow + therect.left);
  221.                     for i := 0 to lines - 1 do begin
  222.                             src3 := ptr(ord4(src2) + plane);
  223.                             dst3 := dst2;
  224.                             for j := 0 to width - 1 do begin
  225.                                     dst3^ := src3^;
  226.                                     src3 := ptr(ord4(src3) + colBytes);
  227.                                     dst3 := ptr(ord4(dst3) + 1);
  228.                                 end;
  229.                             src2 := ptr(ord4(src2) + srcRowBytes);
  230.                             dst2 := ptr(ord4(dst2) + dstRowBytes);
  231.                         end; {for i:=1 to nlines-1}
  232.                 end; {for slice:=1 to 3}
  233.     end;
  234.  
  235.  
  236.     procedure CopyPlanarRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, planeBytes: LongInt; lines, loPlane, hiPlane: integer);
  237.         var
  238.             i, j, slice, plane: integer;
  239.             src2, dst2: ptr;
  240.             width: LongInt;
  241.     begin
  242.         with theRect do
  243.             width := right - left;
  244.         if loPlane = hiPlane then
  245.             planeBytes := 0;
  246.         if (planeBytes < 0) or (planeBytes > srcRowBytes) then
  247.             planeBytes := width;
  248.         with info^.StackInfo^ do
  249.             for plane := loPlane to hiPlane do begin
  250.                     slice := plane + 1;
  251.                     if slice > 3 then
  252.                         slice := 3;
  253.                     CurrentSlice := slice;
  254.                     SelectSlice(slice);
  255.                     src2 := ptr(ord4(src) + planeBytes * plane);
  256.                     dst2 := ptr(ord4(info^.PicBaseAddr) + LongInt(therect.top) * info^.BytesPerRow + therect.left);
  257.                     for i := 0 to lines - 1 do begin
  258.                             BlockMove(src2, dst2, width);
  259.                             src2 := ptr(ord4(src2) + srcRowBytes);
  260.                             dst2 := ptr(ord4(dst2) + dstRowBytes);
  261.                         end;
  262.                 end;
  263.     end;
  264.  
  265.  
  266.     function MakeRGBStack (name: str255; width, height: integer): boolean;
  267.         var
  268.             ignore: integer;
  269.     begin
  270.         MakeRGBStack := false;
  271.         if not NewPicWindow('RGB', width, height) then
  272.             exit(MakeRGBStack);
  273.         if not MakeStackFromWindow then
  274.             exit(MakeRGBStack);
  275.         if not AddSlice(false) then begin
  276.                 info^.changes := false;
  277.                 ignore := CloseAWindow(info^.wptr);
  278.                 exit(MakeRGBStack);
  279.             end;
  280.         if not AddSlice(false) then begin
  281.                 info^.changes := false;
  282.                 ignore := CloseAWindow(info^.wptr);
  283.                 exit(MakeRGBStack);
  284.             end;
  285.         MakeRGBStack := true;
  286.     end;
  287.  
  288.     procedure GetSFCurDir (var vRefNum: integer; var DirID: LongInt);
  289.   {From "Inside Macintosh:Files", page 3-31.}
  290.         type
  291.             IntPtr = ^integer;
  292.             LongIntPtr = ^LongInt;
  293.         const
  294.             SFSaveDisk = $214;
  295.             CurDirStore = $398;
  296.     begin
  297.         vRefNum := -IntPtr(SFSaveDisk)^;
  298.         DirID := LongIntPtr(CurDirStore)^;
  299.     end;
  300.  
  301.     procedure SetSFCurDir (vRefNum: integer; DirID: LongInt);
  302.         type
  303.             IntPtr = ^integer;
  304.             LongIntPtr = ^LongInt;
  305.         const
  306.             SFSaveDisk = $214;
  307.             CurDirStore = $398;
  308.     begin
  309.         IntPtr(SFSaveDisk)^ := -vRefNum;
  310.         LongIntPtr(CurDirStore)^ := dirID;
  311.     end;
  312.  
  313.  
  314.     procedure CheckScreenDepth;
  315.   {Go back to 8-bit mode if the RasterOps plug-in has switched monitor into 24-bit mode.}
  316.         var
  317.             MainDevice: GDHandle;
  318.             err: OSErr;
  319.     begin
  320.         MainDevice := GetMainDevice;
  321.         if (MainDevice^^.gdPmap^^.PixelSize <> 8) and System7 then
  322.             err := SetDepth(MainDevice, 8, 1, 1);
  323.     end;
  324.  
  325.  
  326.     function isSystem7: boolean;
  327.     begin
  328.         if not System7 then {These routines uses File Manager calls only available under System 7.}
  329.             PutMessage('System 7 required to use plug-ins.');
  330.         isSystem7 := System7;
  331.     end;
  332.  
  333.  
  334.     procedure LoadCodeResource (FileName: str255; fType: osType; var codePtr: ProcPtr);
  335.         var
  336.             myReply: StandardFileReply;
  337.             myTypes: SFTypeList;
  338.             err: OSErr;
  339.             CodeResource: handle;
  340.             GotSpec: boolean;
  341.             spec: FSSpec;
  342.             SaveVol: integer;
  343.             SaveDir: LongInt;
  344.     begin
  345.         GotSpec := false;
  346.         if FileName <> '' then begin
  347.                 err := FSMakeFSSpec(PluginsVRefNum, PluginsDirID, FileName, spec);
  348.                 GotSpec := err = noerr;
  349.             end;
  350.         if not GotSpec then begin
  351.                 GetSFCurDir(SaveVol, SaveDir);
  352.                 if PluginsVRefNum <> 0 then
  353.                     SetSFCurDir(PluginsVRefNum, PluginsDirID);
  354.                 myTypes[0] := fType;
  355.                 StandardGetFile(nil, 1, myTypes, myReply);
  356.                 if myReply.sfGood then begin
  357.                         spec := myReply.sfFile;
  358.                         FileName := myReply.sfFile.name;
  359.                         GotSpec := true
  360.                     end;
  361.                 GetSFCurDir(PluginsVRefNum, PluginsDirID);
  362.                 SetSFCurDir(SaveVol, SaveDir);
  363.             end;
  364.         if GotSpec then begin
  365.                 refnum := FSpOpenResFile(spec, fsCurPerm);
  366.                 if (refnum <> -1) then begin
  367.                         if fType = '8BAM' then begin {Acquistion plug-in}
  368.                                 if pos('Raster', FileName) <> 0 then {Can't show progress indicator if RasterOps frame grabber.}
  369.                                     ShowProgress := false;
  370.                                 if FileName <> LastAcqPlugIn then
  371.                                     acqData := 0;
  372.                                 LastAcqPlugIn := FileName;
  373.                             end
  374.                         else if fType = '8BFM' then begin  {Filter plug-in}
  375.                                 if FileName <> LastFilterPlugIn then begin
  376.                                         filterData := 0;
  377.                                         FilterRec.parameters := nil;
  378.                                     end;
  379.                                 LastFilterPlugIn := FileName;
  380.                             end
  381.                         else if fType = '8BEM' then begin  {Export plug-in}
  382.                                 if FileName <> LastExportPlugIn then
  383.                                     exportData := 0;
  384.                                 LastExportPlugIn := FileName;
  385.                             end;
  386.                         UseResFile(refnum);
  387.                         codeResource := GetIndResource(fType, 1);
  388.                         hlock(codeResource);
  389.                         codePtr := ProcPtr(codeResource^);
  390.                     end
  391.                 else
  392.                     PutMessage(concat('Error opening plug-in. (Code=', Long2Str(ResError), ')'));
  393.             end;
  394.     end;
  395.  
  396.  
  397.     procedure CallCode (selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer; codePtr: ProcPtr);
  398.     inline
  399.         $205F,   {move.l (a7)+,a0}
  400.         $4E90;   {jsr (a0)}
  401.  
  402.  
  403.     procedure LoadAcqPlugIn (FileName: str255);
  404.  
  405.         const
  406.             AcquireAbout = 0;
  407.             AcquireStart = 1;
  408.             AcquireContinue = 2;
  409.             AcquireFinish = 3;
  410.             AcquirePrepare = 4;
  411.  
  412.             BitMapMode = 0;
  413.             GrayScaleMode = 1;
  414.             IndexedColorMode = 2;
  415.             RGBColorMode = 3;
  416.  
  417.         var
  418.             thiserror: qderr;
  419.             codePtr: ProcPtr;
  420.             AcqRec: acquirerecord;
  421.             result, i, selector, width, height: integer;
  422.             ok: boolean;
  423.             dst: ptr;
  424.             name: str255;
  425.  
  426.         procedure ShowInfo (str: str255);
  427.         begin
  428.             with AcqRec do
  429.                 if ControlKeyDown then begin
  430.                         str := concat(str, cr, cr, 'imageMode=', long2str(imageMode));
  431.                         str := concat(str, cr, 'width=', long2str(therect.right - therect.left));
  432.                         str := concat(str, cr, 'height=', long2str(therect.bottom - therect.top));
  433.                         str := concat(str, cr, 'depth=', long2str(depth));
  434.                         str := concat(str, cr, 'planes=', long2str(planes));
  435.                         str := concat(str, cr, 'colBytes=', long2str(colBytes));
  436.                         str := concat(str, cr, 'rowBytes=', long2str(rowBytes));
  437.                         str := concat(str, cr, 'planeBytes=', long2str(planeBytes));
  438.                         str := concat(str, cr, 'planeMap=', long2str(planeMap[0]), ' ', long2str(planeMap[1]), long2str(planeMap[2]), ' ', long2str(planeMap[3]));
  439.                         str := concat(str, cr, 'loPlane=', long2str(loPlane));
  440.                         str := concat(str, cr, 'hiPlane=', long2str(hiPlane));
  441.                         ShowMessage(str);
  442.                     end;
  443.         end;
  444.  
  445.         procedure CopyLUT;
  446.             var
  447.                 i: integer;
  448.         begin
  449.             with info^ do begin
  450.                     for i := 0 to 255 do
  451.                         with cTable[i], cTable[i].rgb, AcqRec do begin
  452.                                 value := 0;
  453.                                 red := bsl(rLUT[255 - i], 8);
  454.                                 green := bsl(gLUT[255 - i], 8);
  455.                                 blue := bsl(bLUT[255 - i], 8);
  456.                             end;
  457.                     LoadLUT(cTable);
  458.                     SetupPseudocolor;
  459.                     LutMode := ColorLUT;
  460.                     IdentityFunction := false;
  461.                     UpdateMap;
  462.                 end
  463.         end;
  464.  
  465.         procedure abort;
  466.         begin
  467.             CloseResFile(RefNum);
  468.             if MeterWindow <> nil then begin
  469.                     DisposeWindow(MeterWindow);
  470.                     MeterWindow := nil;
  471.                 end;
  472.             PicLeft := PicLeftBase;
  473.             PicTop := PicTopBase;
  474.             exit(LoadAcqPlugIn);
  475.         end;
  476.  
  477.     begin
  478.         if not isSystem7 then
  479.             exit(LoadAcqPlugIn);
  480.         ShowProgress := true;
  481.         codePtr := nil;
  482.         LoadCodeResource(FileName, '8BAM', codePtr);
  483.         if codePtr = nil then
  484.             exit(LoadAcqPlugIn);
  485.         with AcqRec do begin
  486.                 SerialNumber := 12345;
  487.                 AbortProc := @TestAbort;
  488.                 ProgressProc := @UpdateProgress;
  489.                 MaxData := maxBlock div 2;
  490.                 if MaxData < 25000 then begin
  491.                         PutMessage('Out of memory.');
  492.                         abort;
  493.                     end;
  494.                 imageHRes := 0;
  495.                 hostSig := 'Imag';
  496.                 hostProc := @DummyProc;
  497.                 hostModes := 14;{=1110, i.e., grayscale, indexed color and RGB}
  498.                 for i := 0 to 15 do begin
  499.                         planemap[i] := i;
  500.                     end;
  501.                 FileName := '';
  502.                 canTranspose := false;
  503.                 needTranspose := false;
  504.                 duoToneInfo := nil;
  505.                 diskSpace := -1;
  506.                 spaceProc := nil;
  507.                 monitor.gamma := 0;
  508.                 for i := 0 to 255 do
  509.                     reserved[i] := chr(0);
  510.             end;
  511.         ProgressMsg := 'Acquiring Image…';
  512.         CallCode(AcquirePrepare, @AcqRec, acqData, result, codePtr);
  513.         if (result <> 0) then begin
  514.                 if result < 0 then
  515.                     PutMessage(concat('Plug-in error(result code=', long2str(result), ').'));
  516.                 abort;
  517.             end;
  518.         CallCode(AcquireStart, @AcqRec, acqData, result, codePtr);{call main dialog box etc.}
  519.         if (result <> 0) then
  520.             abort;
  521.         if AcqRec.depth = 1 then begin
  522.                 PutMessage('Image does not support acquisition of bitmap(black and white) images.');
  523.                 abort;
  524.             end;
  525.         OpeningPlugInWindow := true; {Causes MakeNewWindow to open window offscreen.}
  526.         if AcqRec.ImageMode = RGBColorMode then
  527.             ok := MakeRGBStack('Untitled', AcqRec.fImageSize.h, AcqRec.fImageSize.v)
  528.         else begin
  529.                 if FileName <> '' then
  530.                     name := FileName
  531.                 else
  532.                     name := 'Untitled';
  533.                 ok := NewPicWindow(name, AcqRec.fImageSize.h, AcqRec.fImageSize.v);
  534.             end;
  535.         OpeningPlugInWindow := false;
  536.         if not ok then
  537.             abort;
  538.         with info^, AcqRec do
  539.             if ImageMode = GrayScaleMode then begin
  540.                     if LUTMode = ColorLUT then
  541.                         ResetGrayMap
  542.                 end
  543.             else if ImageMode = RGBColorMode then
  544.                 ResetGrayMap
  545.             else if ImageMode = IndexedColorMode then
  546.                 CopyLUT;
  547.         ShowWatch;
  548.         repeat
  549.             CallCode(AcquireContinue, @AcqRec, acqData, result, codePtr);
  550.             with AcqRec do
  551.                 if (result = 0) and (data <> nil) then begin
  552.                         width := therect.right - therect.left;
  553.                         height := therect.bottom - therect.top;
  554.                         ShowInfo('Continue');
  555.                         with Info^ do
  556.                             if ((therect.left + width) <= PixelsPerLine) and (therect.top < nlines) then begin
  557.                                     if (ImageMode = RGBColorMode) and (planes >= 3) and ((hiPlane - loPlane) < 3) then begin
  558.                                             if planeBytes = 1 then
  559.                                                 CopyInterleavedRGBData(data, theRect, rowBytes, Info^.BytesPerRow, colBytes, height, planeMap)
  560.                                             else
  561.                                                 CopyPlanarRGBData(data, theRect, rowBytes, Info^.BytesPerRow, planeBytes, height, loPlane, hiPlane)
  562.                                         end
  563.                                     else
  564.                                         CopyData(data, theRect, rowBytes, Info^.BytesPerRow, height);
  565.                                 end;
  566.                     end;
  567.         until (result <> 0) or (AcqRec.data = nil);
  568.         CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr);{finish}
  569.         CloseResFile(RefNum);
  570.         if MeterWindow <> nil then begin
  571.                 DisposeWindow(MeterWindow);
  572.                 MeterWindow := nil;
  573.             end;
  574.         CheckScreenDepth;
  575.         MoveWindow(info^.wptr, PicLeft, PicTop, true);
  576.         if AcqRec.imageHRes <> 0 then
  577.             with info^ do begin
  578.                     xSpatialScale := FixRound(AcqRec.imageHRes);
  579.                     ySpatialScale := xSpatialScale;
  580.                     PixelAspectRatio := 1.0;
  581.                     xUnit := 'inch';
  582.                     SpatiallyCalibrated := true;
  583.                     UpdateTitleBar;
  584.                 end;
  585.         if info^.StackInfo <> nil then
  586.             with info^.StackInfo^ do begin
  587.                     for i := nSlices downto 1 do begin
  588.                             CurrentSlice := i;
  589.                             SelectSlice(CurrentSlice);
  590.                             InvertPic;
  591.                         end;
  592.                     UpdateTitleBar;
  593.                     ConvertRGBToEightBitColor(true);
  594.                 end
  595.         else
  596.             InvertPic;
  597.         if AcqRec.ImageMode = IndexedColorMode then begin
  598.                 FixColors;
  599.                 WhatToUndo := NothingToUndo;
  600.             end;
  601.     end;
  602.  
  603.  
  604.     procedure PutPlugInMsg (str: str255);
  605.     begin
  606.         PutMessage(concat(str, ' plug-ins found. Plug-ins must be in a folder named "Plug-ins" located in either the same folder as Image or in the System Folder.'));
  607.     end;
  608.  
  609.  
  610.     procedure RunAcqPlugIn (item: integer);
  611.         var
  612.             name: str255;
  613.     begin
  614.         if nAcqPlugIns = 0 then begin
  615.                 PutPlugInMsg('No acquisition');
  616.                 exit(RunAcqPlugIn);
  617.             end;
  618.         GetItem(AcquireMenuH, item, name);
  619.         LoadAcqPlugIn(name);
  620.     end;
  621.  
  622.  
  623.     procedure LoadExportPlugIn (FileName: str255);
  624.  
  625.         const
  626.             ExportAbout = 0;
  627.             ExportStart = 1;
  628.             ExportContinue = 2;
  629.             ExportFinish = 3;
  630.             ExportPrepare = 4;
  631.  
  632.             BitMapMode = 0;
  633.             GrayScaleMode = 1;
  634.             IndexedColorMode = 2;
  635.             RGBColorMode = 3;
  636.  
  637.         var
  638.             thiserror: qderr;
  639.             codePtr: ProcPtr;
  640.             ExportRec: ExportRecord;
  641.             result, i, selector, width, height: integer;
  642.             ok: boolean;
  643.             dst: ptr;
  644.             roi, empty: rect;
  645.             offset: LongInt;
  646.  
  647.         procedure ShowInfo (str: str255);
  648.         begin
  649.             with ExportRec do
  650.                 if ControlKeyDown then begin
  651.                         str := concat(str, cr, cr, 'imageMode=', long2str(imageMode));
  652.                         str := concat(str, cr, 'width=', long2str(therect.right - therect.left));
  653.                         str := concat(str, cr, 'height=', long2str(therect.bottom - therect.top));
  654.                         str := concat(str, cr, 'depth=', long2str(depth));
  655.                         str := concat(str, cr, 'planes=', long2str(planes));
  656.                         str := concat(str, cr, 'rowBytes=', long2str(rowBytes));
  657.                         str := concat(str, cr, 'loPlane=', long2str(loPlane));
  658.                         str := concat(str, cr, 'hiPlane=', long2str(hiPlane));
  659.                         ShowMessage(str);
  660.                     end;
  661.         end;
  662.  
  663.         function BadRect: boolean;
  664.         begin
  665.             BadRect := false;
  666.             with info^.PicRect do begin
  667.                     if (ExportRec.theRect.left < left) or (exportRec.theRect.right > right) or (exportRec.theRect.top < top) or (exportRec.theRect.bottom > bottom) then
  668.                         BadRect := true;
  669.                 end;
  670.         end;
  671.  
  672.         procedure abort (result: integer);
  673.         begin
  674.             CloseResFile(RefNum);
  675.             if MeterWindow <> nil then begin
  676.                     DisposeWindow(MeterWindow);
  677.                     MeterWindow := nil;
  678.                 end;
  679.             InvertPic;
  680.             if result < 0 then
  681.                 PutMessage(concat('Plug-in error(result code=', long2str(result), ').'));
  682.             exit(LoadExportPlugIn);
  683.         end;
  684.  
  685.     begin
  686.         if not isSystem7 then
  687.             exit(LoadExportPlugIn);
  688.         SetRect(empty, 0, 0, 0, 0);
  689.         with info^ do
  690.             if RoiShowing then
  691.                 roi := RoiRect
  692.             else
  693.                 roi := empty;
  694.         ShowProgress := true;
  695.         codePtr := nil;
  696.         LoadCodeResource(FileName, '8BEM', codePtr);
  697.         if codePtr = nil then
  698.             exit(LoadExportPlugIn);
  699.         InvertPic;
  700.         with ExportRec, info^ do begin
  701.                 SerialNumber := 12345;
  702.                 AbortProc := @TestAbort;
  703.                 ProgressProc := @UpdateProgress;
  704.                 MaxData := maxBlock div 2;
  705.                 if MaxData < 25000 then begin
  706.                         PutMessage('Out of memory.');
  707.                         abort(0);
  708.                     end;
  709.                 if LUTMode = Grayscale then
  710.                     ImageMode := GrayScaleMode
  711.                 else
  712.                     ImageMode := IndexedColorMode;
  713.                 with PicRect, eImageSize do begin
  714.                         h := right - left;
  715.                         v := bottom - top;
  716.                     end;
  717.                 depth := 8;
  718.                 planes := 1;
  719.                 imageHRes := bsl(72, 16);
  720.                 imageVRes := imageHRes;
  721.                 for i := 0 to 255 do
  722.                     with cTable[i].rgb do begin
  723.                             rLUT[255 - i] := chr(bsr(red, 8));
  724.                             gLUT[255 - i] := chr(bsr(green, 8));
  725.                             bLUT[255 - i] := chr(bsr(blue, 8));
  726.                         end;
  727.                 theRect := empty;
  728.                 loPlane := 0;
  729.                 hiPlane := 0;
  730.                 data := PicBaseAddr;
  731.                 rowBytes := BytesPerRow;
  732.                 FileName := title;
  733.                 vRefNum := vRef;
  734.                 dirty := changes;
  735.                 selectBBox := roi;
  736.                 hostSig := 'Imag';
  737.                 hostProc := @DummyProc;
  738.                 duoToneInfo := nil;
  739.                 thePlane := 0;
  740.                 monitor.gamma := 0;
  741.                 for i := 0 to 255 do
  742.                     reserved[i] := chr(0);
  743.             end;
  744.         ProgressMsg := 'Exporting Image…';
  745.         CallCode(ExportPrepare, @ExportRec, ExportData, result, codePtr);
  746.         if (result <> 0) then
  747.             abort(result);
  748.         CallCode(ExportStart, @ExportRec, ExportData, result, codePtr);{call main dialog box etc.}
  749.         if (result <> 0) then
  750.             abort(result);
  751.         ShowWatch;
  752.         repeat
  753.             if BadRect then
  754.                 abort(0);
  755.             with ExportRec, info^ do begin
  756.                     offset := LongInt(theRect.top) * BytesPerRow + theRect.left;
  757.                     data := ptr(ord4(PicBaseAddr) + offset);
  758.                 end;
  759.             CallCode(exportContinue, @exportRec, exportData, result, codePtr);
  760.         until (result <> 0) or EmptyRect(exportRec.theRect);
  761.         CallCode(ExportFinish, @ExportRec, ExportData, result, codePtr);
  762.         CloseResFile(RefNum);
  763.         if MeterWindow <> nil then begin
  764.                 DisposeWindow(MeterWindow);
  765.                 MeterWindow := nil;
  766.             end;
  767.         InvertPic;
  768.     end;
  769.  
  770.  
  771.     procedure RunExportPlugIn (item: integer);
  772.         var
  773.             name: str255;
  774.     begin
  775.         if nExportPlugIns = 0 then begin
  776.                 PutPlugInMsg('No export');
  777.                 exit(RunExportPlugIn);
  778.             end;
  779.         GetItem(ExportMenuH, item, name);
  780.         LoadExportPlugIn(name);
  781.     end;
  782.  
  783.  
  784.     procedure LoadFilterPlugIn (FileName: str255);
  785.  
  786.         const
  787.             filterAbout = 0;
  788.             filterParameters = 1;
  789.             filterPrepare = 2;
  790.             filterStart = 3;
  791.             filterContinue = 4;
  792.             filterFinish = 5;
  793.  
  794.             GrayScaleMode = 1;
  795.  
  796.         var
  797.             thiserror: qderr;
  798.             codePtr: ProcPtr;
  799.             result, i, selector, width, height: integer;
  800.             ok: boolean;
  801.             dst: ptr;
  802.             Empty, roi: rect;
  803.             offset: LongInt;
  804.  
  805.         procedure InvertUndoPic;
  806.             var
  807.                 tPort: GrafPtr;
  808.         begin
  809.             GetPort(tPort);
  810.             with UndoInfo^ do begin
  811.                     SetPort(GrafPtr(osPort));
  812.                     InvertRect(PicRect);
  813.                 end;
  814.             SetPort(tPort);
  815.         end;
  816.  
  817.         procedure abort;
  818.         begin
  819.             CloseResFile(RefNum);
  820.             InvertPic;
  821.             InvertUndoPic;
  822.             if MeterWindow <> nil then begin
  823.                     DisposeWindow(MeterWindow);
  824.                     MeterWindow := nil;
  825.                 end;
  826.             exit(LoadFilterPlugIn);
  827.         end;
  828.  
  829.         function BadRect: boolean;
  830.         begin
  831.             BadRect := false;
  832.             with info^.PicRect do begin
  833.                     if (FilterRec.inRect.left < left) or (FilterRec.inRect.right > right) or (FilterRec.inRect.top < top) or (FilterRec.inRect.bottom > bottom) then
  834.                         BadRect := true;
  835.                     if (FilterRec.outRect.left < left) or (FilterRec.outRect.right > right) or (FilterRec.outRect.top < top) or (FilterRec.outRect.bottom > bottom) then
  836.                         BadRect := true;
  837.                 end;
  838.         end;
  839.  
  840.     begin {LoadFilterPlugIn}
  841.         if not isSystem7 then
  842.             exit(LoadFilterPlugIn);
  843.         if macro then
  844.             if FileName = 'Reset' then begin
  845.                     FilterRec.parameters := nil;
  846.                     exit(LoadFilterPlugIn);
  847.                 end;
  848.         if NotInBounds or NoUndo or NotRectangular then
  849.             exit(LoadFilterPlugIn);
  850.         with info^ do
  851.             if RoiShowing then
  852.                 roi := RoiRect
  853.             else
  854.                 roi := PicRect;
  855.         KillRoi;
  856.         SetupUndo;
  857.         SetupUndoInfoRec;
  858.         InvertPic;
  859.         InvertUndoPic;
  860.         WhatToUndo := UndoFilter;
  861.         ShowProgress := true;
  862.         codePtr := nil;
  863.         LoadCodeResource(FileName, '8BFM', codePtr);
  864.         if codePtr = nil then
  865.             exit(LoadFilterPlugIn);
  866.         SetRect(Empty, 0, 0, 0, 0);
  867.         with FilterRec, info^ do begin
  868.                 serialnumber := 12345;
  869.                 AbortProc := @TestAbort;
  870.                 ProgressProc := @UpdateProgress;
  871.                 with PicRect, fImageSize do begin
  872.                         h := right - left;
  873.                         v := bottom - top;
  874.                     end;
  875.                 planes := 1;
  876.                 filterRect := roi;
  877.                 background := WhiteRGB;
  878.                 foreground := BlackRGB;
  879.                 maxSpace := PixMapSize;
  880.                 bufferSpace := 0;
  881.                 inRect := Empty;
  882.                 inLoPlane := 0;
  883.                 inHiPlane := 0;
  884.                 outRect := Empty;
  885.                 outLoPlane := 0;
  886.                 outHiPlane := 0;
  887.                 inData := UndoBuf;
  888.                 inRowBytes := BytesPerRow;
  889.                 outData := PicBaseAddr;
  890.                 outRowBytes := BytesPerRow;
  891.                 isFloating := false;
  892.                 haveMask := false;
  893.                 autoMask := false;
  894.                 maskRect := Empty;
  895.                 maskData := nil;
  896.                 maskRowBytes := BytesPerRow;
  897.                 for i := 0 to 3 do begin
  898.                         backColor[i] := chr(BackgroundIndex);
  899.                         foreColor[i] := chr(ForegroundIndex);
  900.                     end;
  901.                 hostSig := 'Imag';
  902.                 hostProc := @DummyProc;
  903.                 imageMode := GrayScaleMode;
  904.                 imageHRes := bsl(72, 16);
  905.                 imageVRes := imageHRes;
  906.                 floatCoord.h := 0;
  907.                 floatCoord.v := 0;
  908.                 wholeSize := fImageSize;
  909.                 monitor.gamma := 0;
  910.                 for i := 0 to 255 do
  911.                     reserved[i] := chr(0);
  912.             end;
  913.         ProgressMsg := 'Filtering Image…';
  914.         if not (macro and (FilterRec.parameters <> nil)) then begin
  915.                 CallCode(FilterParameters, @FilterRec, filterData, result, codePtr);
  916.                 if result <> 0 then
  917.                     abort;
  918.             end;
  919.         CallCode(FilterPrepare, @FilterRec, filterData, result, codePtr);
  920.         if result <> 0 then
  921.             abort;
  922.         if FilterRec.bufferSpace > (MaxBlock + MinFree) then begin
  923.                 PutMessage('Not enough memory to run filter.');
  924.                 abort;
  925.             end;
  926.         CallCode(FilterStart, @FilterRec, filterData, result, codePtr);
  927.         if result <> 0 then
  928.             abort;
  929.         ShowWatch;
  930.         repeat
  931.             if BadRect then
  932.                 abort;
  933.             with FilterRec, info^ do begin
  934.                     offset := LongInt(inRect.top) * BytesPerRow + inRect.left;
  935.                     inData := ptr(ord4(UndoBuf) + offset);
  936.                     offset := LongInt(outRect.top) * BytesPerRow + outRect.left;
  937.                     outData := ptr(ord4(PicBaseAddr) + offset);
  938.                 end;
  939.             CallCode(filterContinue, @FilterRec, filterData, result, codePtr);
  940.         until (result <> 0) or (EmptyRect(FilterRec.inRect) and EmptyRect(FilterRec.outRect));
  941.         CallCode(filterFinish, @FilterRec, filterData, result, codePtr);
  942.         CloseResFile(RefNum);
  943.         if MeterWindow <> nil then begin
  944.                 DisposeWindow(MeterWindow);
  945.                 MeterWindow := nil;
  946.             end;
  947.         InvertPic;
  948.         InvertUndoPic;
  949.         UpdatePicWindow;
  950.         info^.changes := true;
  951.     end;
  952.  
  953.  
  954.     procedure RunFilterPlugIn (item: integer);
  955.         var
  956.             name: str255;
  957.     begin
  958.         if nFilterPlugIns = 0 then begin
  959.                 PutPlugInMsg('No filter');
  960.                 exit(RunFilterPlugIn);
  961.             end;
  962.         GetItem(FilterMenuH, item, name);
  963.         LoadFilterPlugIn(name);
  964.     end;
  965.  
  966.  
  967. end.